home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtarea.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  12.7 KB  |  375 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtArea;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *  3.01     | 02.02.92 |  Hp  | MoveDial ge„ndert. Dadurch sparen sich *
  29.  *           |          |      | die Module mtDials und mtPopups eine   *
  30.  *           |          |      | Menge Rechnerei...                     *
  31.  *           |          |      | Routinen allgemein optimiert           *
  32.  *-----------+----------+------+----------------------------------------*)
  33.  
  34.  
  35.  
  36. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  37. (*                                              *)
  38. (*$R-   Range-Checks                            *)
  39. (*$S-   Stack-Check                             *)
  40. (*                                              *)
  41. (*----------------------------------------------*)
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  51.  
  52.  
  53.  
  54.  
  55. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  56.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  57.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  58.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  59.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  60.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  61.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  62.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69. FROM SYSTEM     IMPORT  ADDRESS, ADR, WORD, BYTE, TSIZE;
  70. FROM MagicVDI   IMPORT  VDIIntIn, VDIIntOut, VDIPtsIn, VDIPtsOut, VDIControl,
  71.                         VDICall, tWorkIn, tWorkOut, MFDB;
  72. FROM mtUtils    IMPORT  tRect, AbsRect;
  73. FROM mtAppl     IMPORT  Bitplanes, MouseOn, MouseOff, DeskX, DeskY,
  74.                         MaxWidth, MaxHeight;
  75. IMPORT  MagicAES, MagicVDI;
  76.  
  77.  
  78. TYPE    AREA =          POINTER TO Area;
  79.         Area =          RECORD
  80.                          x:     sINTEGER;
  81.                          y:     sINTEGER;
  82.                          w:     sINTEGER;
  83.                          h:     sINTEGER;
  84.                          init:  BOOLEAN;
  85.                          size:  lCARDINAL;
  86.                          mfdbadr: ADDRESS;
  87.                          mfdb:  MFDB;
  88.                         END;
  89.  
  90. VAR     control7:       POINTER TO ADDRESS; (* it's tricky... *)
  91.         control9:       POINTER TO ADDRESS;
  92.         r:              POINTER TO tRect;
  93.  
  94. VAR     ScreenMFDB:     MFDB;   (* MFDB fr Bildschirm    *)
  95.         ScreenPtr:      ADDRESS;
  96.         Screen:         tRect;  (* Ausmaže des gesamten Schirms *)
  97.  
  98. PROCEDURE NewAREA (VAR a: AREA): BOOLEAN;
  99. BEGIN
  100.  ALLOCATE (a,  TSIZE (Area));  
  101.  IF a = NIL THEN  RETURN FALSE;  END;
  102.  a^.x:= -1;
  103.  a^.y:= -1;
  104.  a^.w:= -1;
  105.  a^.h:= -1;
  106.  a^.init:= FALSE;
  107.  a^.size:= 0FFFFFFFFH;
  108.  a^.mfdb.fdAddr:= NIL;
  109.  a^.mfdbadr:= ADR (a^.mfdb);
  110.  RETURN TRUE;
  111. END NewAREA;
  112.  
  113. PROCEDURE DisposeAREA (VAR a: AREA);
  114. BEGIN
  115.  IF a = NIL THEN  RETURN;  END;
  116.  DEALLOCATE (a^.mfdb.fdAddr, 0);  
  117.  DEALLOCATE (a, 0);  
  118.  a:= NIL;
  119. END DisposeAREA;
  120.  
  121. PROCEDURE FreeArea (a: AREA);
  122. BEGIN
  123.  IF a = NIL THEN  RETURN;  END;
  124.  DEALLOCATE (a^.mfdb.fdAddr, 0);  
  125.  a^.x:= -1;  a^.y:= -1;  a^.w:= -1;  a^.h:= -1;
  126.  a^.init:= FALSE;
  127.  a^.size:= 0FFFFFFFFH;
  128.  a^.mfdb.fdAddr:= NIL;
  129. END FreeArea;
  130.  
  131. PROCEDURE SaveArea (hndl: sINTEGER; a: AREA; rect: ARRAY OF LOC): BOOLEAN;
  132. VAR b,c,d,e: sINTEGER;
  133. BEGIN
  134.  IF a = NIL THEN RETURN FALSE;  END;
  135.  r:= ADR (rect);
  136.  b:= r^.x;  c:= r^.y;  d:= r^.w;  e:= r^.h;
  137.  WITH a^ DO
  138.   IF init AND ((d > w) OR (e > h)) THEN
  139.    DEALLOCATE (mfdb.fdAddr, 0);   init:= FALSE;
  140.   END;
  141.   IF NOT init THEN
  142.    mfdb.fdWdwidth:= (d + 15) DIV 16;
  143.    mfdb.fdW:= mfdb.fdWdwidth * 16;
  144.    mfdb.fdH:= e + 1;
  145.    mfdb.fdStand:= 0;
  146.    mfdb.fdNplanes:= Bitplanes;
  147.    size:= LONG (mfdb.fdWdwidth) * LONG (mfdb.fdH) * LONG (Bitplanes) * LONG (2);
  148.    ALLOCATE (mfdb.fdAddr,  size);  
  149.    IF mfdb.fdAddr = NIL THEN  RETURN FALSE;  END;
  150.    init:= TRUE;
  151.   END;
  152.   x:= b;  y:= c;  w:= d;  h:= e;
  153.   MouseOff;
  154.   VDIIntIn[0]:= 3;
  155.   VDIPtsIn[0]:= x;
  156.   VDIPtsIn[1]:= y;
  157.   VDIPtsIn[2]:= x + w - 1;
  158.   VDIPtsIn[3]:= y + h - 1;
  159.   VDIPtsIn[4]:= 0;
  160.   VDIPtsIn[5]:= 0;
  161.   VDIPtsIn[6]:= w - 1;
  162.   VDIPtsIn[7]:= h - 1;
  163.   control7^:= ScreenPtr;
  164.   control9^:= mfdbadr;
  165.   VDICall (109, 4, 1, 0, hndl);
  166.   MouseOn;
  167.  END;
  168.  RETURN TRUE;
  169. END SaveArea;
  170.  
  171. PROCEDURE RestoreArea (hndl: sINTEGER; a: AREA);
  172. BEGIN
  173.  IF a = NIL THEN  RETURN;  END;
  174.  WITH a^ DO
  175.   IF init THEN
  176.    MouseOff;
  177.    VDIIntIn[0]:= 3;
  178.    VDIPtsIn[0]:= 0;
  179.    VDIPtsIn[1]:= 0;
  180.    VDIPtsIn[2]:= w - 1;
  181.    VDIPtsIn[3]:= h - 1;
  182.    VDIPtsIn[4]:= x;
  183.    VDIPtsIn[5]:= y;
  184.    VDIPtsIn[6]:= x + VDIPtsIn[2];
  185.    VDIPtsIn[7]:= y + VDIPtsIn[3];
  186.    control7^:= mfdbadr;
  187.    control9^:= ScreenPtr;
  188.    VDICall (109, 4, 1, 0, hndl);
  189.    MouseOn;
  190.   END;
  191.  END;
  192. END RestoreArea;
  193.  
  194. PROCEDURE CopyArea (hndl: sINTEGER; a: AREA; xx, yy: sINTEGER);
  195. BEGIN
  196.  IF a = NIL THEN  RETURN;  END;
  197.  WITH a^ DO
  198.   IF init THEN
  199.    MouseOff;
  200.    VDIIntIn[0]:= 3;
  201.    VDIPtsIn[0]:= 0;
  202.    VDIPtsIn[1]:= 0;
  203.    VDIPtsIn[2]:= w - 1;
  204.    VDIPtsIn[3]:= h - 1;
  205.    VDIPtsIn[4]:= xx;
  206.    VDIPtsIn[5]:= yy;
  207.    VDIPtsIn[6]:= xx + VDIPtsIn[2];
  208.    VDIPtsIn[7]:= yy + VDIPtsIn[3];
  209.    control7^:= mfdbadr;
  210.    control9^:= ScreenPtr;
  211.    VDICall (109, 4, 1, 0, hndl);
  212.    MouseOn;
  213.   END;
  214.  END;
  215. END CopyArea;
  216.  
  217. PROCEDURE MoveArea (hndl: sINTEGER; a: AREA; xm, ym: sINTEGER; VAR xx, yy: sINTEGER);
  218. CONST fly = 3;
  219. VAR (*$Reg*)  p:  sINTEGER;
  220.     (*$Reg*)  mx: sINTEGER;
  221.     (*$Reg*)  my: sINTEGER;
  222.     (*$Reg*)  w1: sINTEGER;
  223.     (*$Reg*)  h1: sINTEGER; 
  224. BEGIN
  225.  IF a = NIL THEN  RETURN  END;
  226.  IF a^.init THEN
  227.   WITH a^ DO
  228.    MouseOff;
  229.    VDIIntIn[0]:= 3;
  230.    mx:= x + w;  my:= y + h;  w1:= w - 1;  h1:= h - 1;
  231.  
  232.    IF ym < 0 THEN (* Nach oben *)
  233.     p:= ABS (ym);  IF p >= (h DIV fly) THEN  p:= h DIV fly;  END;
  234.     IF (y - p) < Screen.y THEN  p:= y - Screen.y;  END;
  235.     IF p > 0 THEN
  236.      (* Bildschirm teilrestaurieren *)
  237.      VDIPtsIn[0]:= 0;           VDIPtsIn[1]:= h - p;
  238.      VDIPtsIn[2]:= w1;          VDIPtsIn[3]:= h1;
  239.      VDIPtsIn[4]:= x;           VDIPtsIn[5]:= my - p;
  240.      VDIPtsIn[6]:= mx - 1;      VDIPtsIn[7]:= my - 1;
  241.      control7^:= mfdbadr;  control9^:= ScreenPtr;
  242.      VDICall (109, 4, 1, 0, hndl);
  243.      (* Rest intern verschieben *)
  244.      VDIPtsIn[0]:= 0;           VDIPtsIn[1]:= 0;
  245.      VDIPtsIn[2]:= w1;          VDIPtsIn[3]:= h - p;
  246.      VDIPtsIn[4]:= 0;           VDIPtsIn[5]:= p;
  247.      VDIPtsIn[6]:= w1;          VDIPtsIn[7]:= h;
  248.      control7^:= mfdbadr;  control9^:= mfdbadr;
  249.      VDICall (109, 4, 1, 0, hndl);
  250.      (* Bildschirm neuen Teil sichern *)
  251.      VDIPtsIn[0]:= x;           VDIPtsIn[1]:= y - p;
  252.      VDIPtsIn[2]:= mx - 1;      VDIPtsIn[3]:= y - 1;
  253.      VDIPtsIn[4]:= 0;           VDIPtsIn[5]:= 0;
  254.      VDIPtsIn[6]:= w1;          VDIPtsIn[7]:= p - 1; (* - 1 added by DS *)
  255.      control7^:= ScreenPtr;  control9^:= mfdbadr;
  256.      VDICall (109, 4, 1, 0, hndl);
  257.      DEC (y, p);  my:= y + h;
  258.     END;
  259.  
  260.    ELSIF ym > 0 THEN (* Nach unten *)
  261.     p:= ym;  IF p >= (h DIV fly) THEN  p:= h DIV fly;  END;
  262.     IF (my + p) > Screen.h THEN  p:= Screen.h - my;  END;
  263.     IF p > 0 THEN
  264.      (* Bildschirm teilrestaurieren *)
  265.      VDIPtsIn[0]:= 0;           VDIPtsIn[1]:= 0;
  266.      VDIPtsIn[2]:= w1;          VDIPtsIn[3]:= p - 1;
  267.      VDIPtsIn[4]:= x;           VDIPtsIn[5]:= y;
  268.      VDIPtsIn[6]:= mx - 1;      VDIPtsIn[7]:= y + p - 1;
  269.      control7^:= mfdbadr;  control9^:= ScreenPtr;
  270.      VDICall (109, 4, 1, 0, hndl);
  271.      (* Rest intern verschieben *)
  272.      VDIPtsIn[0]:= 0;           VDIPtsIn[1]:= p;
  273.      VDIPtsIn[2]:= w1;          VDIPtsIn[3]:= h;
  274.      VDIPtsIn[4]:= 0;           VDIPtsIn[5]:= 0;
  275.      VDIPtsIn[6]:= w1;          VDIPtsIn[7]:= h - p;
  276.      control7^:= mfdbadr;  control9^:= mfdbadr;
  277.      VDICall (109, 4, 1, 0, hndl);
  278.      (* Bildschirm neuen Teil sichern *)
  279.      VDIPtsIn[0]:= x;           VDIPtsIn[1]:= my;
  280.      VDIPtsIn[2]:= mx - 1;      VDIPtsIn[3]:= my + p - 1;
  281.      VDIPtsIn[4]:= 0;           VDIPtsIn[5]:= h - p;
  282.      VDIPtsIn[6]:= w1;          VDIPtsIn[7]:= h1;
  283.      control7^:= ScreenPtr;  control9^:= mfdbadr;
  284.      VDICall (109, 4, 1, 0, hndl);
  285.      INC (y, p);  my:= y + h;
  286.     END;
  287.    END;
  288.  
  289.    IF xm < 0 THEN (* Nach Links *)
  290.     p:= ABS (xm);
  291.     IF p >= (w DIV fly) THEN  p:= w DIV fly;  END;
  292.     IF (x - p) < 0  THEN  p:= x - 1;  END;
  293.     IF NOT ODD (p) THEN DEC (p); END;
  294.     IF p > 0 THEN
  295.      (* Bildschirm teilrestaurieren *)
  296.      VDIPtsIn[0]:= w - p;       VDIPtsIn[1]:= 0;
  297.      VDIPtsIn[2]:= w1;          VDIPtsIn[3]:= h1;
  298.      VDIPtsIn[4]:= mx - p;      VDIPtsIn[5]:= y;
  299.      VDIPtsIn[6]:= mx - 1;      VDIPtsIn[7]:= my - 1;
  300.      control7^:= mfdbadr;  control9^:= ScreenPtr;
  301.      VDICall (109, 4, 1, 0, hndl);
  302.      (* Rest intern verschieben *)
  303.      VDIPtsIn[0]:= 0;           VDIPtsIn[1]:= 0;
  304.      VDIPtsIn[2]:= w1 - p;      VDIPtsIn[3]:= h1;
  305.      VDIPtsIn[4]:= p;           VDIPtsIn[5]:= 0;
  306.      VDIPtsIn[6]:= w1;          VDIPtsIn[7]:= h1;
  307.      control7^:= mfdbadr;  control9^:= mfdbadr;
  308.      VDICall (109, 4, 1, 0, hndl);
  309.      (* Bildschirm neuen Teil sichern *)
  310.      VDIPtsIn[0]:= x - p;       VDIPtsIn[1]:= y;
  311.      VDIPtsIn[2]:= x - 1;       VDIPtsIn[3]:= my - 1;
  312.      VDIPtsIn[4]:= 0;           VDIPtsIn[5]:= 0;
  313.      VDIPtsIn[6]:= p - 1;       VDIPtsIn[7]:= h1;
  314.      control7^:= ScreenPtr;  control9^:= mfdbadr;
  315.      VDICall (109, 4, 1, 0, hndl);
  316.      DEC (x, p);  mx:= x + w;
  317.     END;
  318.  
  319.    ELSIF xm > 0 THEN (* Nach Rechts *)
  320.     p:= xm;  IF p >= (w DIV fly) THEN  p:= w DIV fly;  END;
  321.     IF (mx + p) > Screen.w THEN  p:= Screen.w - mx;  END;
  322.     IF NOT ODD (p) THEN DEC (p); END;
  323.     IF p > 0 THEN
  324.      (* Bildschirm teilrestaurieren *)
  325.      VDIPtsIn[0]:= 0;           VDIPtsIn[1]:= 0;
  326.      VDIPtsIn[2]:= p - 1;       VDIPtsIn[3]:= h1;
  327.      VDIPtsIn[4]:= x;           VDIPtsIn[5]:= y;
  328.      VDIPtsIn[6]:= x + p - 1;   VDIPtsIn[7]:= my - 1;
  329.      control7^:= mfdbadr;  control9^:= ScreenPtr;
  330.      VDICall (109, 4, 1, 0, hndl);
  331.      (* Rest intern verschieben *)
  332.      VDIPtsIn[0]:= p;           VDIPtsIn[1]:= 0;
  333.      VDIPtsIn[2]:= w1;          VDIPtsIn[3]:= h1;
  334.      VDIPtsIn[4]:= 0;           VDIPtsIn[5]:= 0;
  335.      VDIPtsIn[6]:= w1 - p;      VDIPtsIn[7]:= h1;
  336.      control7^:= mfdbadr;  control9^:= mfdbadr;
  337.      VDICall (109, 4, 1, 0, hndl);
  338.      (* Bildschirm neuen Teil sichern *)
  339.      VDIPtsIn[0]:= mx;       VDIPtsIn[1]:= y;
  340.      VDIPtsIn[2]:= mx + p - 1;  VDIPtsIn[3]:= my - 1;
  341.      VDIPtsIn[4]:= w - p;       VDIPtsIn[5]:= 0;
  342.      VDIPtsIn[6]:= w1;          VDIPtsIn[7]:= h1;
  343.      control7^:= ScreenPtr;  control9^:= mfdbadr;
  344.      VDICall (109, 4, 1, 0, hndl);
  345.      INC (x, p);  mx:= x + w;
  346.     END;
  347.    END;
  348.   END;
  349.   MouseOn;
  350.   xx:= a^.x;
  351.   yy:= a^.y;
  352.  END;
  353. END MoveArea;
  354.  
  355. VAR init: sCARDINAL;
  356.  
  357. PROCEDURE InitMtArea;
  358. BEGIN
  359.  IF init # 30961 THEN
  360.   Screen.x:= DeskX;  Screen.y:= DeskY;
  361.   Screen.w:= MaxWidth;  Screen.h:= MaxHeight;
  362.   ScreenMFDB.fdAddr:= Null;
  363.   ScreenPtr:= ADR (ScreenMFDB);
  364.   control7:= ADR (VDIControl[7]);
  365.   control9:= ADR (VDIControl[9]);
  366.   init:= 30961;
  367.  END;
  368. END InitMtArea;
  369.  
  370. BEGIN
  371.  init:= 0;
  372.  InitMtArea;
  373. END mtArea.
  374.  
  375.